00100		TITLE PLOT
00200		INTERNAL PLOT,VARIAN
00300		EXTERNAL  EXTOUT,FINEXT,EXIT,PUTEXT,OUTF,TTOP,DL,TYPWRD
00400	;;	COMMON /DL/RSIZ,SAVER,NAME,EXT
00500	;;TITLE VM     ;PRINTS MUSIC FORMAT FILE ON VARIAN PRINTER.
00600		;↓↓AC DEF
00700	A←1
00800	B←2
00900	C←3
01000	D←4
01100	E←5
01200	L←6
01300	U←7
01400	X←11
01500	Y←12
01600	XD←13
01700	T←15
01800	TT←16
01900	P←17
02000		
02100	;;LPDL←←69
02200	NBUFS←←4
02300	DSK←←1
02400	VRN←←2		;DEVICE NAME OF VARIAN STATOS
02500	
02600	LMAR←←=0
02700	RMAR←←=4223	;WILL DO 10.2" LONG MAXIMUM
02800	WIDTH←←=4224	;22" WIDE PAPER    -- MAYBE 21 WOULD BE BETTER?
02900	LBUFL←←=118	;LINE LENGTH IN WORDS
03000	
03100	LSTBIT←←1⊗34
03200	
03300	OVERLAP←←=50
03400	
03500	EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
03600	MAILBF:	BLOCK 40
03700	SIGN:	0
03800	LINE:	0
03900	PNTR:	0
04000	
04100	SVX:	0
04200	SVY:	0
04300	SVPEN:	0
04400	
04500	
04600	LX:	0
04700	VARIAN:	0		;DO SET UP FOR VARIAN OUTPUT.
04800		MOVEM 16,ACZ  	;SAVE AC16 FOR RETURN
04900		MOVNM  4,LX		;L=1
05000		SETZM OUTF+2	;VECTOR COUNTER (TEMPORARY, I HOPE)
05100		MOVEI 4,=50000
05200		MOVEM 4,TTOP+1		;INITIALIZE JBOT AND JTOP
05300		MOVNM 4,TTOP  		;JBOT=50000, JTOP=-50000
05400		MOVNM 4,RTMAX#		;RTMX=-50000
05500		MOVEM 4,SVX	;INIT OLD X AND Y
05600		MOVEM 5,SVY
05610		MOVE 0,[1700.0]	;STANDARD PAGE WIDTH=8.5"
05620		FMPR 0,DL	;TIMES GIVEN SIZE FACTOR
05630		KIFIX		;FIX IT
05640		MOVEM PWIDTH	;THIS WILL ALSO BE IN THE HEADER (SEE LATER)
05650		MOVE [900.0]
05660		FMPR DL		;GET THE OFFSET VALUE
05670		KIFIX
05680		MOVEM SHIFT#	;USED IN MAIN LOOP - AFTER PLOT1
05700	XNTF4:	MOVE 0,OUTF   	;***** THIS CONVERTS ASCIZ WORD TO SIXBIT***
05800		MOVEM 0,FNX#		;				   *
05900		MOVE 1,[POINT 7,FNX]	;				   *
06000	XNTF3:	MOVE 2,[POINT 6,FILNAM]	;				   *
06100		SETZM FILNAM		;				   *
06200		MOVEI 3,5		;				   *
06300	XNTF1:	ILDB 0,1		;				   *
06400		CAIN 0," "		;				   *
06500		JRST XNTF2		;				   *
06600		SUBI 0,40		;				   *
06700		IDPB 0,2		;				   *
06800		SOJG 3,XNTF1	;*******************************************
06900	XNTF2:	SETOM	OUTF		;JJ=-1	IS THIS NEEDED?
07000		PUSHJ P,SETUP		;GO SET UP VM PROG.
07100		SKIPN SAVBIT	;WRITE A FILE?
07200		JRST PLZ	;NO
07300		SETZM SVX
07400		MOVEI 3
07500		MOVEM SVPEN
07600		MOVE SVBBB		;NUMB OF SCAN LINES-1
07700		SUB SHIFT		;LESS SHIFT NUMBER
07800		MOVEM ACZ+1	;SAVE Y FOR BLACK DOT
07900		MOVEM SVY	;GO SEND AN INVIS. VECTOR TO MAXIMUM Y POS.
08000		PUSHJ P,PLOT1	; IN ORDER TO GET PROPER AMOUNT OF CLEAN CORE. 3/24/80
08100		MOVEI 2
08200		MOVEM SVPEN
08300		MOVE ACZ+1
08400		MOVEM SVY
08500		SETZM SVX	;RESET X AND Y
08600		PUSHJ P,PLOT1	;MAKE A DOT AT POINT OUTSIDE OF VARIAN PROG.'S WINDOW
08700	PLZ:	MOVE 16,ACZ		;GET BACK AC16
08800		JRA 16,(16)		;VARIAN SETUP ALL DONE
08900	
09000	PLOT:	0		;SUBROUTINE PLOT(I,J,K)
09100		PUSHJ P,SAVACZ		;SAVE ALL ACS
09200	PL4:	MOVE	5,@2(16)	;4	IF(K.EQ.99)GO TO 1
09300	;;;	CAIN	5,=99
09400	   	CAIE	5,=99
09500	   	JRST PLX
09600	   	SKIPE SAVBIT		;WRITE FILE?
09700	   	JRST OUTFIL	;YES	PUSHJ P,OUTFIL		;GO OUTPUT BIT MAP
09800	   	JRST PCUT		;GO DO OUTPUT TO VRN.
09900	PLX:	MOVEM 5,SVPEN
10000		MOVN 5,@(16)  ;MOVE 4,@(16)	;IF(X2.EQ.SVX.AND.Y2.EQ.SVY)RETURN
10100		MOVE 4,@1(16) ; ROTATE !! MOVE 5,@1(16)	;AVOID DUPLICATE COORDS.
10200		CAMN 4,SVX
10300		CAME 5,SVY
10400		JRST DIFRNT
10500		SKIPL 15,@2(16)	;SKIP IF -3 IN PEN CODE
10600		JRA	16,3(16)	;RETURN
10700	DIFRNT:	MOVEM 4,SVX
10800		MOVEM 5,SVY		;SAVE X AND Y FOR NEXT TIME
10900		PUSHJ P,PLOT1	;GO TO BIT MAP ROUTINE
11000		PUSHJ P,GETACZ	;GET BACK ALL ACS
11100	
11200		AOS OUTF+2	;UPDATE VECT. COUNTER
11300	NZZ:	MOVE 1,@1(16) ;****ALL THIS TO FIND TRUE VERTICAL SIZE OF IMAGE.
11400		MOVEI 0,2	;****
11500		CAME 0,SVPEN	;**** IS PEN DOWN (=2)?
11600		JRST NXX	;**** NO
11700		CAMLE 1,TTOP	;**** GETS Y COORD.
11800		MOVEM 1,TTOP	;****
11900		CAMGE 1,TTOP+1	;****	THIS AREA SAVES TOP AND BOT LIMITS
12000		MOVEM 1,TTOP+1	;****
12100	  	MOVE 1,INVIS	;****
12200		CAMLE 1,TTOP	;****
12300		MOVEM 1,TTOP	;****	  THIS TO AVOID INCLUDING 1ST AND LAST
12400		CAMGE 1,TTOP+1	;****	  INVISIBILE POSITIONS.
12500		MOVEM 1,TTOP+1	;****
12600		MOVE 1,@(16)	; GET X COORD.
12700		CAMLE 1,RTMAX	; IS THIS FURTHER TO RIGHT?
12800		MOVEM 1,RTMAX	;YES	WRITE THIS AS LAST WD. OF FILE
12900		JRST NWW	;****
13000	NXX:	MOVEM 1,INVIS#	;****
13100		SKIPL SVPEN	;****	SKIP IF PEN=-3 (RESETS TO 0,0)
13200		JRST NWW	;****
13300		MOVN 1,@1(16)	;****  GET Y FOR PEN RESET
13400		ADDM 1,TTOP	;**** SUBTRACT NEW POS. FROM BOTH TOP AND BOT
13500		ADDM 1,TTOP+1	;****
13600	NWW:	MOVE	7,LX
13700		JRA	16,3(16)	;GO BACK FOR ANOTHER VECTOR
     

00100	SETUP:	SETOM LINE
00200		GETLIN LINE		;FOR ERROR PRINTOUT
00300		CALLI
00400		HRRZS LINE		;CLEAR LINE BITS
00500		HRRZI A,CORUP
00600		HRRZM A,JOBAPR
00700		SETOM SSS#
00800		SETZM ROT1#		;1ST TIME FLAG
00900		SETZM SAVBIT#		;FLAG TO SAVE BITS.
01000		HRRZ A,JOBFF		;RESET CORE WITHOUT A RESET
01100		CORE A,
01200		JRST 4,.
01300	
01400		MOVEI	A,20000		;REG MPV
01500		APRENB	A,		;REG  ENABLE OLD WAY!
01600	
01700		OUTSTR [ASCIZ/WRITE .VRN FILE?  Y OR <CR>=PRINT DIRECT  /]
01800		PUSHJ P,GETNAM
01900		CAMN A,[SIXBIT/Y/]
02000		SETOM SAVBIT
02100		PUSHJ P,INCHLF	;LOOK FOR LINE-FEED
02200	FILIN:	HRREI B,-60
02300		HRREI A,-=1400	;-=2000	; YES, DEFAULT = 10"
02400	YDEF:	ADD A,B
02500		MOVNM A,INIX#
02600	ASKLEN:	SETZM POOBX#
02700		SETZM POOBY#
02800		PUSHJ P,XINI		;GET X INFO
02900		SETZM XX#
03000		SETZM YY#
03100		MOVEI C,3
03200		HRRZM C,PENN#
03300		PUSHJ P,SAVAC	;SAVE ALL ACS
03400		POPJ P,		;GO BACK TO OLD PLOT
     

00100	XINI:	OUTSTR [ASCIZ /PAGE HEIGHT? (<CR>=11")  /]
00200		PUSHJ P,RNUM	;SKIP NEXT IF A NUMBER WAS TYPED.
00300		JRST DEFAU 		;USE DEFAULT VALUE  11"=850 X OFFSET
00400		SUBI A,=11		;TAKE AWAY BASIC 11" HEIGHT
00500		IMULI A,=200		;200 LINES/INCH
00600		SUBI A,=850		;LESS DEFAULT OFFSET
00700		MOVNS A
00800		SKIPA
00900	DEFAU:	MOVEI A,=850
01000		MOVEM A,XSHIFT#		;X OFFSET VALUE
01100	;	MOVEI A,=900
01200	;IYDEF:	MOVEM A,SHIFT#	;A MINUS NUMBER SHIFTS IMAGE DOWN OFF PAGE
01300	;	MOVEI A,=1702	;+2 TO EXPAND TO SUFFICIENT CORE
01310		MOVE A,PWIDTH
01320		ADDI A,2	;+2 TO EXPAND TO SUFFICIENT CORE
01400		MOVEI B,-1(A)
01500		IMULI A,LBUFL+1		;A← BUFSIZ ← ROWS * COL
01600		MOVE T,JOBFF		;GET START ADDR
01700		MOVEM T,XGPPTR
01800		SOS XGPPTR
01900		MOVEI T,2(A)
02000		MOVNI TT,(T)
02100		ADD T,XGPPTR
02200		HRLM TT,XGPPTR		;XGPPTR← -WDCNT,,ADDR-1
02300		MOVE TT,T
02400	
02500		HRRZ L,XGPPTR
02600		MOVSI T,1(L)
02700		HRRI T,2(L)
02800	 	SETZM 1(L)
02900	 	MOVE U,JOBREL
03000	 	BLT T,(U)		;ZERO TO END OF CORE
03100		HRRZI U,(TT)
03200		MOVEM B,SVBBB#
03300		
03400		MOVEI Y,2(L)
03500		MOVEI XD,DBUF+1
03600		SKIPL A,INIX		;WHERE DO WE START
03700		JRST MAYBON
03800		SUBI A,43
03900		IDIV A,[-44]
04000		HRLOI X,XD
04100		SOJA A,SETB
04200	
04300	MAYBON:	ADDI A,43
04400		IDIVI A,44
04500		CAILE A,LBUFL
04600		JRST OFFRT
04700		MOVE X,A
04800		SETZ A,
04900		HRLI X,Y
05000		JRST SETB
05100	
05200	OFFRT:	MOVE X,[XD,,LBUFL]
05300		SUBI A,LBUFL
05400	SETB:	MOVE B,INIX
05500		IDIVI B,44
05600		MOVSI B,400000
05700		MOVN C,C
05800		ROT B,(C)
05900		POPJ P,
06000	
06100	POPJ1:	AOS (P)
06200	CPOPJ:	POPJ P,
06300	
     

00100	PLOT1:	PUSHJ P,GETAC		;GET BACK ALL ACS
00200		MOVE 15,SVPEN
00300		JUMPG 15,NORSET		;NEXT FOR RESET OF COORDS TO 0,0  (SVPEN=-1)
00400		MOVE 15,SVX
00500		SKIPN ROT1#	;ROT1=FLAG FOR FIRST TIME
00600		sub 15,INIX	;1ST TIME SHIFT.  ADD INITIAL OFFSET
00700		ADDM 15,XSHIFT	;GET NEW XSHIFT
00800		SETOM ROT1
00900		POPJ P,
01000	
01100	NORSET:	MOVE A,SVPEN		;GET PEN CODE - NO RESET
01200		MOVE 15,SVY
01300	SSSS:	ADD 15,SHIFT#	;SHIFTS ONLY AFTER (0,0) IS SET (SVPEN=-3)
01400		MOVEM 15,SVY		;GET Y
01500		SUB 15,YY
01600		MOVEM 15,SVYSB#		;SAVE Y DIFF
01700		IMULI 15,LBUFL+1
01800		ADD 15,Y
01900	YOK:	MOVEM 15,SVYOD#		;SAVE NEW Y
02000		CAIL 15,(L)		;OFF BOTTOM
02100		CAILE 15,-LBUFL-1(U)	;OFF TOP
02200		JRST LOSE
02300		MOVE 15,SVX
02400		ADD 15,XSHIFT		;ADD SHIFT IF ROTATED   (IT IS)
02500		MOVEM 15,SVX		;GET X
02600		SUB 15,XX
02700		MOVE 0,15		;0 HAS X DIFF
02800		HRRZ 16,X
02900		IMULI 16,44	;TIMES BITS INA WORD
03000		JFFO B,.+1	
03100		ADD 16,C	;PLUS REMAINDER EQ OLD X
03200		SUB 16,15
03300		JUMPL 16,LOSEX
03400		CAILE 16,=4427
03500		JRST LOSEX
03600		SKIPE OOBFLG#		;CK IF ALREADY OOB
03700		JRST OOBAR
03800	FIXUP:	CAIE A,1	;FIXUP WHAT?
03900		HRRM A,PENN
04000		HRR A,PENN	;SAME PEN IF 1
04100		CAIN A,3
04200		JRST PENUP	;PENUP IF 3
04300		MOVE C,SVYSB	;Y DIFF
04400		IORM B,@X	;MARK NOW X Y
04500				;FIND DIRECTION
04600		JUMPE NORMX	;VERT OR NO MOVE
04700		JUMPL MVLFT	;LEFT
04800		JUMPE C,NRT	;HORZ
04900		JUMPL C,MVDWN	;DOWN
05000		CAMLE C,0	;JUMP IF Y DIFF > X DIFF
05100		JRST XCHA
05200	
05300		SETZ 14,	;↓↓ MOVE UP AND RIGHT
05400		TLNE C,200000
05500		JRST .+4
05600		LSH C,1
05700		TRO C,1
05800		AOJA 14,.-4
05900		SUBI 14,=34
06000		IDIV C,0
06100		MOVNS 14
06200		LSH C,(14)
06300		SETZ 15,
06400	INLOOP:	ADD 15,C
06500		TLZE 15,200000
06600		ADDI Y,LBUFL+1
06700		SKIPGE B
06800		SOJ X,
06900		ROT B,1
07000		IORM B,@X
07100		SOJG INLOOP
07200		JRST DONXT
07300	
     

00100	XCHA:	SETZ 14,	;↓↓MOVE UP AND RIGHT
00200		TLNE 0,200000
00300		JRST .+4
00400		LSH 0,1
00500		TRO 0,1
00600		AOJA 14,.-4
00700		SUBI 14,=34
00800		IDIV 0,C
00900		MOVNS 14
01000		LSH 0,(14)
01100		SETZ 15,
01200	INLOO:	ADD 15,0
01300		TLZN 15,200000
01400		JRST MVUP
01500		SKIPGE B
01600		SOJ X,
01700		ROT B,1
01800	MVUP:	ADDI Y,LBUFL+1
01900		IORM B,@X
02000		SOJG C,INLOO
02100		JRST DONXT
02200	
02300	MVDWN:	MOVMS C		;↓↓MOVE DOWN AND RIGHT
02400		CAMLE C,0
02500		JRST XCHA2	;JUMP IF YDIFF > XDIFF
02600		SETZ 14,
02700		TLNE C,200000
02800		JRST .+4
02900		LSH C,1
03000		TRO C,1
03100		AOJA 14,.-4
03200		SUBI 14,=34
03300		IDIV C,0
03400		MOVNS 14
03500		LSH C,(14)
03600		SETZ 15,
03700	INLOP:	ADD 15,C
03800		TLZE 15,200000
03900		SUBI Y,LBUFL+1
04000		SKIPGE B
04100		SOJ X,
04200		ROT B,1
04300		IORM B,@X
04400		SOJG INLOP
04500		JRST DONXT
04600	
04700	XCHA2:	SETZ 14,	;↓↓MOVE DOWN AND RIGHT
04800		TLNE 0,200000
04900		JRST .+4
05000		LSH 0,1
05100		TRO 0,1
05200		AOJA 14,.-4
05300		SUBI 14,=34
05400		IDIV 0,C
05500		MOVNS 14
05600		LSH 0,(14)
05700		SETZ 15,
05800	INOOP:	ADD 15,0
05900		TLZN 15,200000
06000		JRST MVEX
06100		SKIPGE B
06200		SOJ X,
06300		ROT B,1
06400	MVEX:	SUBI Y,LBUFL+1
06500		IORM B,@X
06600		SOJG C,INOOP
06700		JRST DONXT
06800	
06900	NRT:	JUMPL B,GOOP	;HORZ RIGHT
07000	TOOT:	ROT B,1
07100		IORM B,@X
07200		SOJG 0,NRT
07300		JRST DONXT
07400	GOOP:	SOJ X,
07500		CAIGE 0,44
07600		JRST TOOT
07700		IDIVI 0,44
07800		SETOM @X
07900		SOJ X,
08000		SOJG 0,.-2
08100		HRR 0,1
08200		JUMPN 0,TOOT
08300		AOJ X,
08400		JRST DONXT
08500	
08600	NLFT:	MOVMS 0		;HORZ LEFT
08700		ROT B,-1
08800		JUMPL B,ROOT
08900	WOOP:	IORM B,@X
09000		SOJG 0,.-3
09100		JRST DONXT
09200	ROOT:	AOJ X,
09300		CAIGE 0,44
09400		JRST WOOP
09500		IDIVI 0,44
09600		SETOM @X
09700		AOJ X,
09800		SOJG 0,.-2
09900		HRR 0,1
10000		JUMPN 0,WOOP
10100		SOJ X,
10200		ROT B,1
10300		JRST DONXT
10400	NORMX:	JUMPE C,SAVAC	;ENOUT	;NO DIFF
10500		JUMPL C,MDOWN	;MOVE VERT DOWN
10600	MUP:	ADDI Y,LBUFL+1	;MOVE VERT UP
10700		IORM B,@X
10800		SOJG C,MUP
10900		JRST DONXT
11000	MDOWN:	SUBI Y,LBUFL+1	;MOVE VERT DOWN
11100		IORM B,@X
11200		AOJL C,MDOWN
11300	DONXT:	MOVE 4,SVX	;DONE. NOW UPDATE X AND Y
11400		MOVEM 4,XX
11500	NXTY:	MOVE 4,SVY
11600		MOVEM 4,YY
11700	;ENOUT:	JRST SAVAC	;SAVE ALL ACS
11800		     		;AOBJN E,PLOT1	;GET NEXT
11900	
12000	SAVAC:	MOVEM 16,ACS+16		;SAVE AC16
12100		MOVEI 16,ACS		;ARG. FOR BLT
12200		BLT 16,ACS+15		;WE'VE ALREADY SAVED AC16
12300		MOVE 16,ACS+16
12400		POPJ P,
12500	
12600	ACS:	BLOCK 17	;SAVE AC'S 0-16
12700	
12800	GETAC:	HRLZI 16,ACS
12900		BLT 16,16	;GET 'EM ALL BACK
13000		POPJ P,
13100	
13200	SAVACZ:	MOVEM 16,ACZ+16		;SAVE AC16
13300		MOVEI 16,ACZ		;ARG. FOR BLT
13400		BLT 16,ACZ+15		;WE'VE ALREADY SAVED AC16
13500		MOVE 16,ACZ+16
13600		POPJ P,
13700	
13800	ACZ:	BLOCK 17	;SAVE AC'S 0-16
13900	
14000	GETACZ:	HRLZI 16,ACZ
14100		BLT 16,16	;GET 'EM ALL BACK
14200		POPJ P,
     

00100	MVLFT:	MOVMS 0		;MOVE LEFT THEN RIGHT
00200		MOVMS 15
00300		JUMPE C,NLFT
00400		HRR Y,SVYOD
00500		IDIVI 15,44
00600		ADD X,15
00700	XEND:	SOJL 16,DUN
00800		ROT B,-1
00900		JUMPGE B,XEND
01000		AOJ X,
01100		JRST XEND
01200	DUN:	MOVEM X,XX	;SAVE NEW X POS
01300		MOVEM B,YY
01400		IORM B,@X
01500		JUMPL C,MVLD
01600		CAMLE C,0
01700		JRST XCHA3
01800		SETZ 14,	;MOVE LEFT UP
01900		TLNE C,200000
02000		JRST .+4
02100		LSH C,1
02200		TRO C,1
02300		AOJA 14,.-4
02400		SUBI 14,=34
02500		IDIV C,0
02600		MOVNS 14
02700		LSH C,(14)
02800		SETZ 15,
02900	ILOOP:	ADD 15,C
03000		TLZE 15,200000
03100		SUBI Y,LBUFL+1
03200		SKIPGE B
03300		SOJ X,
03400		ROT B,1
03500		IORM B,@X
03600		SOJG ILOOP
03700		JRST BFOR
03800	
03900	XCHA3:	SETZ 14,
04000		TLNE 0,200000
04100		JRST .+4
04200		LSH 0,1
04300		TRO 0,1
04400		AOJA 14,.-4
04500		SUBI 14,=34
04600		IDIV 0,C
04700		MOVNS 14
04800		LSH 0,(14)
04900		SETZ 15,
05000	ILOP:	ADD 15,0
05100		TLZN 15,200000
05200		JRST DOQ
05300		SKIPGE B
05400		SOJ X,
05500		ROT B,1
05600	DOQ:	SUBI Y,LBUFL+1
05700		IORM B,@X
05800		SOJG C,ILOP
05900		JRST BFOR
06000	
06100	MVLD:	MOVMS C		;MOVE LEFT DOWN
06200		CAMLE C,0
06300		JRST XCHA4
06400		SETZ 14,
06500		TLNE C,200000
06600		JRST .+4
06700		LSH C,1
06800		TRO C,1
06900		AOJA 14,.-4
07000		SUBI 14,=34
07100		IDIV C,0
07200		MOVNS 14
07300		LSH C,(14)
07400		SETZ 15,
07500	LOOP:	ADD 15,C
07600		TLZE 15,200000
07700		ADDI Y,LBUFL+1
07800		SKIPGE B
07900		SOJ X,
08000		ROT B,1
08100		IORM B,@X
08200		SOJG LOOP
08300		JRST BFOR
08400	
08500	XCHA4:	SETZ 14,
08600		TLNE 0,200000
08700		JRST .+4
08800		LSH 0,1
08900		TRO 0,1
09000		AOJA 14,.-4
09100		SUBI 14,=34
09200		IDIV 0,C
09300		MOVNS 14
09400		LSH 0,(14)
09500		SETZ 15,
09600	LOP:	ADD 15,0
09700		TLZN 15,200000
09800		JRST DOP
09900		SKIPGE B
10000		SOJ X,
10100		ROT B,1
10200	DOP:	ADDI Y,LBUFL+1
10300		IORM B,@X
10400		SOJG C,LOP
10500	
10600	BFOR:	HRR Y,SVYOD	;RESTORE PEN TO NEW PEN
10700		MOVE X,XX
10800		MOVE B,YY
10900		JRST DONXT
11000	
     

00100	OOBAR:	SETZM OOBFLG	; GET HERE IF ALL READY OOB
00200		AOSG SSS	; THIS IS FOR THE FIRST OOB FROM MP
00300		JRST FIXUP	;
00400	PENUP:	HRR Y,SVYOD	; PEN IS UP GET NEW Y
00500		JUMPE 15,NXTY	;IF VERT
00600		JUMPL 15,PULFT	;IF LEFT
00700		CAIGE 15,44	;↓↓MOVE UP PEN RIGHT TO NEW X
00800		JRST XLOOP
00900		IDIVI 15,44
01000		SUB X,15
01100		HRR 15,16
01200	XLOOP:	SOJL 15,DONXT
01300		SKIPGE B
01400		SOJ X,
01500		ROT B,1
01600		JRST XLOOP
01700	
01800	PULFT:	MOVMS 15	;↓↓MOVE UP PEN LEFT TO NEW X
01900		CAIGE 15,44
02000		JRST OOO
02100		IDIVI 15,44
02200		ADD X,15
02300		HRR 15,16
02400	OOO:	SOJL 15,DONXT
02500		ROT B,-1
02600		JUMPGE B,OOO
02700		AOJ X,
02800		JRST OOO
02900	
03000	LOSEX:	MOVE SVPEN	;IF PEN IS UP DON'T PRINT MESSAGE
03100		CAIN 3
03200		JRST PENUP
03300		SETOM OOBFLG	;OOB X
03400		SKIPE POOBX
03500		JRST PENUP
03600		SETOM POOBX
03700		PUSHJ P,DETCHK
03800	 	 PUSHJ P,XERR
03900		PUSHJ P,ERRPNT
04000		ASCIZ / POINT OUT OF BOUNDS, /
04100		JUMPL 16,[PUSHJ P,ERRPNT
04200			  ASCIZ/-X/
04300			  JRST PENUP]
04400		PUSHJ P,ERRPNT
04500		ASCIZ/+X/
04600		JRST PENUP
04700	
04800	LOSE:	SETOM OOBFLG	;OOB Y
04900		SKIPE POOBY
05000		JRST LOBAC
05100		SETOM POOBY
05200		PUSHJ P,DETCHK
05300		PUSHJ P,XERR
05400		PUSHJ P,ERRPNT
05500		ASCIZ / POINT OUT OF BOUNDS, /
05600		CAIGE 15,(L)
05700		JRST [	PUSHJ P,ERRPNT
05800			ASCIZ/-Y/
05900			JRST LOBAC]
06000		PUSHJ P,ERRPNT
06100		ASCIZ/+Y/
06200	LOBAC:	LSHC 14,-16
06300		ASH 15,-26
06400		MOVEM 15,SVX
06500		SUB 15,XX
06600		JRST PENUP
06700	
06800	DECOUT:	IDIVI T,=10	;DEC TTY OUT
06900		HRLM TT,(P)
07000		SKIPE T
07100		PUSHJ P,DECOUT
07200		HLRZ TT,(P)
07300		ADDI TT,60
07400		ROT TT,-7
07500		MOVEM TT,.+2
07600		PUSHJ P,ERRPNT
07700		0
07800		POPJ P,
07900	
08000	ERRPNT:	HRRZ TT,(P)		;ERROR TTY OUT
08100		MOVEM TT,PNTR
08200		MOVEI TT,LINE
08300		TTYMES TT,
08400		JRST [	OUTSTR[ASCIZ/TTYMES FAILED	/]
08500			OUTSTR @PNTR
08600			OUTSTR[ASCIZ/
08700	/]
08800			JRST .+1]
08900		POP P,TT
09000		HRL TT,(TT)
09100		TLNE TT,376
09200		AOJA TT,.-2
09300		JRST 1(TT)
09400	
09500	XERR:	PUSHJ P,ERRPNT		;DET TTY OUT
09600		ASCIZ/
09700	MESSAGE FROM X WORKING ON /
09800		MOVE TT,FILNAM
09900		PUSHJ P,SIXOUT
10000		PUSHJ P,ERRPNT
10100		ASCIZ/./
10200		HLLZ TT,FILEXT
10300		PUSHJ P,SIXOUT
10400		PUSHJ P,ERRPNT
10500		ASCIZ/[/
10600		MOVE TT,FILPPN
10700		PUSHJ P,SIXOUT
10800		PUSHJ P,ERRPNT
10900		ASCIZ/] : /
11000		POPJ P,
11100	
11200	SIXOUT:	JUMPE TT,CPOPJ		;SIXBIT OUT
11300		SETZ T,
11400		LSHC T,6
11500		ADDI T,40
11600		PUSH P,TT
11700		ROT T,-7
11800		MOVEM T,.+2
11900		PUSHJ P,ERRPNT
12000		0
12100		POP P,TT
12200		JRST SIXOUT
12300	
12400	DETCHK:	SETOM DET#	;CK FOR DET JOB
12500		GETLIN DET
12600		HRRES DET
12700		SKIPL DET
12800		AOS (P)
12900		POPJ P,
13000	
     

00100	FINDL:	HRRZ A,JOBREL		;CK IF BIG ENUF
00200		CAIL A,-LBUFL-1(U)
00300		JRST XINL-1
00400	XL2:	MOVEM TT,(T)		;ADD MORE AND MARK
00500		ADDI T,LBUFL+1
00600		CAIGE T,(A)
00700		JRST XL2
00800		SUBI A,(L)
00900		MOVNS A
01000		HRLM A,XGPPTR
01100		SUBI T,LBUFL+1
01200		JRST XXOUT
01300	
01400	PCUT:	PUSHJ P,GETAC		;GET BACK ACS
01500		HRRZ L,XGPPTR				;MARK BLOCK FOR XGP
01600		MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
01700		MOVEM TT,1(L)		;FIRST ONE HAS MARK AND CUT WITH IT
01800		TLZ TT,400000		;DELETE MARK AND CUT
01900		MOVEI T,1+LBUFL+1(L)
02000	;;	SKIPGE DEFA		;IF(DEFA.EQ.0)WE GET C.5" OF EXTRA PAPER
02100		JRST FINDL
02200		MOVE B,SVBBB
02300	XINL:	MOVEM TT,(T)
02400		ADDI T,LBUFL+1
02500		SOJG B,XINL
02600		HLRO TT,XGPPTR
02700		MOVNS TT
02800		ADDI TT,(L)
02900		MOVE A,(TT)
03000	XXOUT:	MOVSI TT,400100
03100		MOVEM TT,(T)		;SO DOES LAST
03200	
03300	XGPOUT:	SKIPE SAVBIT		;SAVE THE BIT MAP?
03400		JRST OUTFIL		;YES
03500		OPEN VRN,XNIT		;XGP OUTPUT
03600		JRST NOXGP
03700		OUTSTR[ASCIZ/
03800	CRANKING VRN
03900	/]
04000		LOCK
04100	OUTIT:	OUT VRN,XGPPTR
04200		JRST OUTOK
04300	DSKERR:	PUSHJ P,DETCHK
04400		PUSHJ P,XERR
04500		PUSHJ P,ERRPNT
04600		ASCIZ /VRN OUTPUT ERROR.
04700	/
04800	OUTOK:	UNLOCK
04900		RELEAS VRN,
05000	XMORE:	PUSHJ P,DETCHK
05100		JFCL
05200		OUTSTR[ASCIZ/R=REPEAT, X=EXIT  /]
05300		INCHRW C
05400		CAIE C,15
05500		JRST .+3
05600		INCHRW C
05700		JRST XMORE+2			; WON'T ACCEPT JUST CRLF
05800		OUTSTR[ASCIZ/
05900	/]
06000		CAIE C,"X"
06100		CAIN C,"x"
06200		SKIPA
06300		JRST .+3
06400		PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
06500		JRST NODEL 
06600		CAIE C,"R"
06700		CAIN C,"r"
06800		JRST XGPOUT
06900		JRST XMORE+2	;******* NO DELETE FEATURE IN THIS VERSION.
07000	
07100		CAIE C,"D"
07200		CAIN C,"d"
07300		SKIPA   			;IF NOT R, X OR D TRY AGAIN.
07400		JRST XMORE+2
07500		PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
07600	DODEL:	MOVE A,[FILNAM,,LKENT]
07700		BLT A,LKENT+3
07800		INIT DSK,17
07900		'DSK   '
08000		0
08100		JRST [	SKIPGE DET
08200			PUSHJ P,XERR
08300			PUSHJ P,ERRPNT
08400			ASCIZ/COULDN'T GET DISK FOR DELETE!
08500	/
08600			JRST NODEL]
08700		LOOKUP DSK,LKENT
08800		JRST [	SKIPGE DET
08900			PUSHJ P,XERR
09000			PUSHJ P,ERRPNT
09100			ASCIZ/LOOKUP FOR DELETE FAILED!
09200	/
09300			JRST NODEL]
09400		MOVE A,FILPPN
09500		MOVEM A,LKENT+3
09600		SETZM LKENT
09700		RENAME DSK,LKENT
09800		CAIA
09900		JRST NODEL
10000		SKIPGE DET
10100		PUSHJ P,XERR
10200		PUSHJ P,ERRPNT
10300		ASCIZ/RENAME FOR DELETE FAILED!
10400	/
10500	NODEL:	RELEASE DSK,
10600		SKIPGE DET
10700		PUSHJ P,XERR
10800		PUSHJ P,ERRPNT
10900		ASCIZ/ALL DONE!
11000	/
11100		CALLI 12		;LEAVE
11200	
11300	NOXGP:	PUSHJ P,DETCHK
11400		PUSHJ P,XERR
11500		PUSHJ P,ERRPNT
11600	   	ASCIZ /
11700	WAITING FOR VRN -- /
11800		HRRZI A,1017
11900		HRRZM A,XNIT
12000		JRST XGPOUT
12100	
12200	XNIT:	417
12300		'VRN   '
12400		0
12500	XGPPTR:	BLOCK 2
12600	
12700	IFN LSTBIT-1,<
12800	XFIX:	MOVE A,[LSTBIT-1]
12900		HRRZ C,JOBREL
13000		HRRZ D,XGPPTR
13100	XFIXL:	ANDCAM A,LBUFL-1+2(D)
13200		ADDI D,LBUFL+1
13300		CAIGE D,(C)
13400		JRST XFIXL
13500		POPJ P,
13600	>
13700	CORDWN:	MOVE T,JOBFF
13800		SUBI T,1
13900		CALLI T,11
14000		JRST 4,.
14100		POPJ P,
14200	
     

00100	INBITS:	PUSHJ P,NAMGET		;INPUT OLD BIT FILE
00200		HRRZ U,JOBFF
00300		HRRZI T,177(U)
00400		CORE T,
00500		JRST INBITS
00600		SOJ U,
00700		HRLI U,-200
00800		OPEN [17↔'DSK   '↔0]
00900		JRST INBITS
01000		LOOKUP FILNAM
01100		JRST INBITS
01200		SETZ 10,
01300	TRYTRY:	OPEN VRN,XNIT	  ;***** GRAB THE VRN BEFORE CORE EXPANSION
01400		JRST NONO    	 ;CAN'T GET IT!
01500		INPUT U
01600		MOVE T,[BYTE (12)4001,LMAR,LBUFL]
01700		EXCH T,1(U)
01800		HLL U,T
01900		MOVEM U,XGPPTR
02000		HRLI U,(T)
02100		TLNN U,777777
02200		JRST CLOZE
02300		ADDI U,200
02400		MOVNI T,(T)
02500		ADDI T,(U)
02600		CORE T,
02700		JRST INBITS	;HANG
02800		INPUT U
02900	CLOZE:	RELEAS
03000		JRST XGPOUT
03100	
03200	NONO:	OUTSTR[ASCIZ/
03300	WAITING FOR VRN  /]
03400		HRRZI A,1017
03500		HRRZM A,XNIT
03600		JRST TRYTRY
03700	
03800	OUTFIL:	OUTSTR [ASCIZ/
03900	 --- WRITING  /]
04000	;	OUTSTR FNX		;THE OUTPUT NAME - SAME AS FILNAM (SIXBIT)
04100		PUSHJ P,SAVAC
04200		JSA 16,TYPWRD
04300		JUMP FNX	;THE FILE NAME
04400		OUTSTR [ASCIZ/.VRN  --   /]
04500		PUSHJ P,GETAC		;I GUESS I NEED ORIGINAL ACS BACK.
04600		MOVSI A,'VRN'
04700		MOVEM A,FILEXT
04800		MOVE U,XGPPTR
04900		HLRO T,U
05000		MOVNS T
05100	OUTF2:	TRZ T,177
05200		HRRZI A,200(T)
05300		ADDI A,(U)
05400		CORE A,
05500		JRST OUTFIL
05600		MOVNS T
05700		HLL T,U			;FIRST WD IS WC-200,-WC
05800		MOVEM T,1(U)
05900		HRLI U,-200(T)
06000		SETZ 10,
06100		OPEN [17↔'DSK   '↔0]
06200		JRST 4,.
06300		ENTER FILNAM
06400		CAIA
06500		MOVEI 0,HEADER
06600		SUBI 0,1
06700		MOVEM 0,COM
06800		MOVNI 0,200   
06900		HRLM 0,COM
07000		OUTPUT COM
07100		STATZ 0,740000
07200		HALT	;ERROR <WRITE ERROR>
07300		OUTPUT U
07400		RELEAS
07500		PUSHJ P,CORDWN		;GET RID OF EXCESS CORE
07600		JRST NODEL
07700	COM:	0
07800		0
07900	HEADER:	0 
08000	      	0
08100		=119		;MUST BE 1 MORE THAN LBUFL ON PAGE 2.
08200		0
08300	PWIDTH: 	=1700	;NUMBER OF SCAN LINES IN FILE.  8.5"
08400		0	;ABOVE IS SET AT INIT STAGE.
08500		117		;WORD 2 +DECIMAL 37 -- NOT NEEDED
08600		0
08700		0
08800		0
     

00100	;CORUP
00200	
00300	CORUP:
00400	
00500	REPEAT 0,<	OLD WAY - FLUSHED BY REG 1-3-76
00600	
00700		HRRZ B,JOBCNI
00800		CAIE B,20000
00900		DISMIS
01000		MOVE A,JOBTPC
01100		MOVEM A,IPC+1
01200		UWAIT
01300		DEBREAK
01400	>;END REPEAT 0
01500	
01600	BUST:	MOVEM	1,SVONE#
01700	 	MOVEM	2,SVTWO#
01800		MOVEM	TT,SVTTT#
01900		MOVE	1,JOBCNI	;REG  GET APR CONI BITS
02000		TRNN	1,20000		;REG  IS THERE AN MPV?
02100		JRST	NOMPV		;REG  NO
02200		HRRZ	1,JOBREL	;OLD CORE SIZE
02300		MOVSI	2,1(1)		;FIRST NEW WORD WE'LL GET
02400		HRRI	2,2(1)		;SECOND NEW WORD  - 2 HAS A BLT POINTER.
02500		ADDI	1,16000
02600	;;	ADDI	1,10000		;GET ANOTHER 8K
02700		MOVE	TT,1
02800		CORE	1,
02900		PUSHJ	P,CORLUZ
03000		HRRZ	1,JOBREL
03100		SETZM	-1(2)
03200	 	BLT	2,(1)		;ZERO NEW CORE
03300		MOVE	1,SVONE
03400	 	MOVE	2,SVTWO
03500		MOVE	TT,SVTTT
03600	
03700	REPEAT 0,<
03800		INTJEN IPC
03900	>
04000	
04100		JRST	2,@JOBTPC	;REG  THIS IS HOW TO DISMISS OLD INTERRUPT
04200	
04300	NOMPV:	OUTSTR	[ASCIZ/UNEXPECTED INTERRUPT?
04400	/]
04500		JRST	2,@JOBTPC
04600	
04700	CORLUZ:	MOVE T,TT
04800		LSH T,-12
04900		PUSH P,T
05000		PUSHJ P,DETCHK
05100		PUSHJ P,XERR
05200		POP P,T
05300		PUSHJ P,DECOUT
05400		PUSHJ P,ERRPNT
05500		ASCIZ / K OF CORE NEEDED!
05600	/
05700		SKIPGE DET
05800		CALLI 12
05900		JRST ASKLEN
06000	
06100	FNF:	PUSHJ P,DETCHK		;FILE NOT FOUND
06200		PUSHJ P,XERR
06300		PUSHJ P,ERRPNT
06400		ASCIZ /LOOKUP FAILED.
06500	/
06600		SKIPGE DET
06700		CALLI 12
06800		JRST FILIN
06900	
     

00100	;******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********
00200	
00300	FRD:	MOVSI A,'PLT'		;FILE SCAN
00400		MOVEM A,FILEXT
00500		PUSHJ P,GETNAM
00600	
00700	NOSAV:	SKIPN A
00800	 	MOVE A,['PLT   ']
00900	    	MOVEM A,FILNAM
01000		CAIE C,"."
01100		JRST NOEXT
01200		PUSHJ P,GETNAM
01300		MOVEM A,FILEXT
01400	NOEXT:	CAIE C,"["
01500		JRST FRDX
01600		PUSHJ P,GETP
01700		HRLZM A,FILPPN
01800		PUSHJ P,GETP
01900		HRRM A,FILPPN
02000	FRDX:	INCHRW C
02100		CAIE C,12
02200		JRST FRDX
02300		POPJ P,
02400	
02500	RNUM:	INCHWL C		;NUM SCAN
02600		CAIN C,15
02700		JRST RNUM
02800		CAIN C,12
02900		POPJ P,
03000		AOS (P)
03100		MOVEI A,
03200		SETZM SIGN
03300		CAIN C,"-"
03400		JRST [	PUSHJ P,RNUML
03500			SETOM SIGN
03600			MOVN A,A
03700			POPJ P,]
03800		CAIN C,"+"
03900	RNUML:	INCHWL C
04000		CAIL C,"0"
04100		CAILE C,"9"
04200		JRST RNUMX
04300		IMULI A,12
04400		ADDI A,-"0"(C)
04500		JRST RNUML
04600	
04700	RNUMX:	CAIN C,15
04800		INCHRW C
04900		POPJ P,
05000	
05100	INCHLF:	INCHWL 0	;GET ANOTHER CHARACTER
05200		CAIE 0,12	;WAS IT A LF?
05300		JRST INCHLF	;GET THE LF
05400		POPJ P,
     

00100	GETNAM:	MOVEI A,		;FILE SCAN
00200		MOVE B,[440600,,A]
00300	GETNML:	PUSHJ P,RCH
00400		POPJ P,
00500		SUBI C,40
00600		TLNE B,770000
00700		IDPB C,B
00800		JRST GETNML
00900	
01000	GETP:	MOVEI A,
01100	GETPL:	PUSHJ P,RCH
01200		POPJ P,
01300		TRNE A,770000
01400		JRST GETPL
01500		LSH A,6
01600		ADDI A,-40(C)
01700		JRST GETPL
01800	
01900	RCH:	INCHWL C
02000		CAIN C,42
02100		JRST RCHQ
02200		CAIE C,11
02300		CAIN C," "
02400		JRST RCH
02500		CAIE C,"."
02600		CAIN C,","
02700		POPJ P,
02800		CAIE C,"["
02900		CAIN C,"]"
03000		POPJ P,
03100	RCHQR:	CAIGE C,40
03200		POPJ P,
03300		CAIL C,"a"
03400		CAILE C,"z"
03500		CAIA
03600		SUBI C,40
03700		JRST POPJ1
03800	
03900	RCHQ:	INCHWL C
04000		JRST RCHQR
04100	
04200	NAMGET:	PUSHJ P,INCHLF
04300		OUTSTR [ASCIZ/
04400		FILE = /]
04500		SETZM FILEXT+1
04600		SETZM FILPPN
04700		MOVSI A,'BIT'
04800		MOVEM A,FILEXT
04900		PUSHJ P,GETNAM
05000		SKIPN A
05100	 	MOVE A,['PLT   ']
05200	    	MOVEM A,FILNAM
05300		CAIE C,"."
05400		JRST NOEXTN
05500		PUSHJ P,GETNAM
05600		MOVEM A,FILEXT
05700	NOEXTN:	CAIE C,"["
05800		JRST FFDX
05900		PUSHJ P,GETP
06000		HRLZM A,FILPPN
06100		PUSHJ P,GETP
06200		HRRM A,FILPPN
06300	FFDX:	INCHRW C
06400		CAIE C,12
06500		JRST FFDX
06600		POPJ P,
06700	
06800	FILNAM:	0			;GLOPS OF JUNK
06900	FILEXT:	0
07000		0
07100	FILPPN:	0
07200	
07300	LKENT:	BLOCK 4
07400	
07500	XGSNAM:	0
07600	XGSEXT:	0
07700		0
07800	XGSPPN:	0
07900	
08000	IBUF:	BLOCK 3
08100	
08200	BITTAB:	FOR I←43,0,-1{1⊗I
08300	}
08400	BYTTAB:	FOR I←36,0,-6{REPEAT 6,{77⊗I}}
08500	
08600	DBUF:	BLOCK LBUFL+2
08700	
08800		END